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-- file Error. Mesa 

-- last modified by Satterthwaite, May 16. 1978 1:23 PM 

DIRECTORY 
ComData: FROM "comdata" 
USING [ 

bodylndex, nErrors, nWarnings, sourceStream, textlndex, warnings], 
CompilerDefs: FROM "compilerdef s" USING [CloseStringTable, OpenStringTable], 
ErrorDefs: FROM "errordefs" USING [ErrorCode], 
ErrorTabDefs: FROM "errortabdefs" USING [CSRptr], 
lODefs: FROM "iodefs" 

USING [ControlZ, CR. WriteChar, WriteDecimal . WriteNumber, WriteString] . 
LitDefs: FROM "litdefs" USING [LiteralValue, StringLiteralValue], 
StreamDefs: FROM "streamdefs" 
USING [ 

Streamlndex, 

CloseDiskStream, Modifylndex, Normal izelndex, OpenDiskStream. Setlndex, 
StreamError], 
StringDefs: FROM "stringdefs" USING [Substring, SubStringDescriptor] . 
SymDefs: FROM "symdefs" 
USING [setype, bodytype, 

HTIndex. ISEIndex, HTNull, SENull. BTNull], 
SymTabDefs: FROM "symtabdefs" USING [SubStringForHash], 
TableDefs: FROM "tabledefs" USING [TableBase, TableBounds], 
TreeDefs: FROM "treedefs" 
USING [treetype. 

NodeName. TreeLink, Treelndex, TreeScan, empty, scanlist]; 

Error: PROGRAM 
IMPORTS 

CompilerDefs, lODefs, LitDefs, StreamDefs, 
SymTabDefs, TableDefs, TreeDefs. 
dataPtr: ComData 
EXPORTS ErrorDefs - 
BEGIN 
OPEN SymDefs, TreeDefs; 

ErrorCode: TYPE ■ ErrorDefs .ErrorCode; 

Substring: TYPE - StringDefs. Substring; 

-- source printing 

PrintTextLine: PROCEDURE [i: CARDINAL] - 
BEGIN OPEN StreamDefs, lODefs; 
start, linelndex: Streamlndex; 
char: CHARACTER; 
n: [1,.100]; 

OpenDiskStream[dataPtr. sourceStream]; 
start ^ linelndex <- Normal izelndex[[page:0. byte:i]]; 
FOR n IN [1..100] UNTIL linelndex » [0. 0] 

DO 

linelndex ♦- ModifyIndex[l inelndex, -1]; 

Se t I ndex [ da taPtr. sourceStream, 1 inelndex]; 

IF dataPtr. sourceStream. get[dataPtr. sourceStream] ■ CR THEN EXIT; 

start <- 1 inelndex; 

ENDLOOP; 
Se t I ndex[ da taPtr. sourceStream, start]; 
FOR n IN [1..100] 

DO 

char <- dataPtr. sourceStream. get[dataPtr. sourceStream 
IStreamError -> EXIT]; 

SELECT char FROM 

CR. ControlZ «> EXIT; 
ENDCASE -> WriteChar[char]; 

ENDLOOP; 
WriteChar[CR]; 

CI oseDiskStream[ dataPtr .sourceStream]; 
RETURN 
END; 

-- CSRp and desc.base are set by LockStringTable 

CSRp: ErrorTabDefs. CSRptr; 

desc: StringDefs .SubStringDescriptor ; 
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ss: Substring " @clesc; 

LockStrlngTable: PROCEDURE ■ 
BEGIN 

CSRp <- Compi1erDefs.0penStringTab1e[]; 
ss.base *- LOOPHOLE[CSRp + CSRp.relativebase. STRING]; 
RETURN 
END; 

WriteSubString: PROCEDURE [ss: Substring] ■ 
BEGIN 

i: CARDINAL; 

FOR i IN [ss. offset. .ss. offset + ss. length) 
DO IODefs.WriteChar[ss.base[i]] ENDLOOP; 
RETURN 
END; 

WriteErrorString: PROCEDURE [n: ErrorCode] ■ 
BEGIN 

ss. offset ^ CSRp. ErrorMessages[n]. offset; 
ss. length <- CSRp. ErrorMessages[n]. length; 
WriteSubString[ss]; 
RETURN 
END; 

WriteHti: PROCEDURE [hti: HTIndex] - 
BEGIN OPEN lODefs; 
desc: StringDef s.SubStringDescriptor; 
s: Substring » 0desc; 
IF hti - HTNun 

THEN WriteString["(anonymous)"L] 

ELSE BEGIN SymTabDef s .SubStringForHash[s , hti]; WriteSubString[s] END; 
RETURN 
END; 

WriteSei: PROCEDURE [sei: ISEIndex] ■ 
BEGIN 
WriteHti[IF sei-SENull 

THEN HTNull 

ELSE (TableOefs.TableBounds[SymDefs.setype].base+sei) .htptr]; 
RETURN 
END; 

WriteLti: PROCEDURE [t: literal TreeLink] - 
BEGIN OPEN lODefs; 
WITH t.info SELECT FROM 

word ■> WriteDecimal[LitDefs.LiteralValue[index]]; 
string -> 
BEGIN 

WriteChar['"3; 

WriteString[LitDef s. St ringLiteralVal ue[ index]]; 
WriteChar['"]; 
END; 
ENDCASE; 
RETURN 
END; 

-- tables used for printing trees 

pname: ARRAY NodeName[assignx . . uparrow] OF STRING ♦- 

" OR ". " AND ", "-", "#". "<", ">-". ">", "<-". " IN ". " -IN ", 

»' + ", "-•', "♦", "/", " MOD ", 

It If ff tt It II II II 

ii^iij 11^./ HQii* "t"]; 

WritePName: PROCEDURE[n: NodeName[assignx. .uparrow]] ■ 
BEGIN 

ss. offset <- CSRp. pname[n]. offset; 
ss. length ♦- CSRp. pname[n]. length; 
WriteSubString[ss]; RETURN 
END; 
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OpPrec: ARRAY NodeName[assignx. .uparrow] OF CARDINAL ■ 
lU 
2, 3, 6, 6, 6| 5| 5, 6t 6* 6t 
6. 6. 7. 7. 7. 
10. 10. 10. 
4. 8. 9, 10]; 

fname: ARRAY NodeName[min. .memory] OF STRING ♦- 
["MIN", "MAX", "LONG". "ABS". 
"SIZE". "FIRST". "LAST", "DESCRIPTOR". 
"LENGTH", "BASE", "LOOPHOLE". "REGISTER". "MEMORY"]; 

WrIteFName: PROCEDURE[n: NocleName[min. .memory]] ■ 
BEGIN 

ss. offset ♦- CSRp.fname[n]. offset; 
ss. length ♦- CSRp.fname[n]. length; 
WriteSubString[ss]; RETURN 
END; 

cutoff: CARDINAL - 3; 

PrintOperand: PROCEDURE [t: TreeLink, tPrec. depth: INTEGER] - 
BEGIN 

node: Treelndex; 
prec: INTEGER; 
op: NodeName; 
args: TreeLink; 
tb: TableDefs.TableBase; 
IF t - empty THEN RETURN; 
WITH e: t SELECT FROM 

hash ■> WriteHti[e. index]; 
symbol »> WriteSei[e. index]; 
literal ■> WriteLti[e]; 
subtree ■> 

BEGIN OPEN TableDefs, lODefs; 

tb ♦- TableBounds[treetype] .base; 

node ^ e. index; op <- ( tb+node) .name; 

IF depth > cutoff THEN BEGIN WriteString[" . . . "L]; RETURN END; 

SELECT op FROM 

IN [apply .. rowconsx], IN [min .. memory] »> 
BEGIN OPEN (tb+node); 
SELECT op FROM 

IN [apply . . rowconsx] »> 
BEGIN 

IF sonl # empty THEN PrintOperand[sonl. 0, depth]; 
args ^ son2; 
END; 
IN [min .. memory] «> BEGIN WriteFName[op]; args ^ sonl END; 
ENDCASE; 
WriteChar['[]; 

IF depth " cutoff AND args. tag ■ subtree 
THEN WriteString["..."L] 
ELSE PrintOperandList[args, depth+1]; 
IF op IN [apply .. join] AND nsons > 2 

THEN WriteString[" 1. .."L]; 
WriteChar[']]; 
END; 
IN [assignx .. uparrow] ■> 
BEGIN OPEN (tb+node); 
prec <r OpPrec[op]; 
IF prec < tPrec THEN WriteChar[ ' (]; 
SELECT op FROM 

IN [not . . addr] -> 

BEGIN WritePName[op]; PrintOperand[sonl. prec, depth] END; 
IN [assignx .. dollar] -> 
BEGIN 

PrintOperand[sonl, prec. depth+1]; 
WritePName[op]; 

PrintOperand[son2, prec+1, depth+1]; 
END; 
uparrow ■> 

BEGIN Pr intOperand[sonl, prec. depth]; WriteChar[ 't] END; 
ENDCASE -> WriteChar['?]; 
IF prec < tPrec THEN WriteChar[ ' )]; 



Error. mesa 2-Sep-78 12:59:59 Page 



END; 
IN [intOO .. intCC] -> 
BEGIN OPEN (tb+node); 

WriteChar[IF op ■ intOO OR op ■ intOC THEN '( ELSE '[]; 
PrintOperand[sonl, 0, depth]; 
Wr1teChar[' .]; WriteChar[' . ] ; 
Print0perand[son2, 0, depth]; 

WriteChar[IF op ■ intOO OR op ■ intCO THEN •) ELSE ']]; 
END; 
clit -> 

BEGIN WriteCharC ']; 
WITH el: (tb+node) .sonl SELECT FROM 
literal -> 
WITH el. info SELECT FROM 

word ■> WriteChar[LOOPHOLE[LitDefs.LiteralValue[index]]]; 
ENDCASE; 
ENDCASE; 
END; 
nit. IN [cast .. openexp] ■> 

PrintOperand[(tb+node) .sonl, tPrec. depth]; 
ENDCASE ■> WriteString["..."L]; 
END; 
ENDCASE; 
RETURN 
END; 

PrintOperandList: PROCEDURE [t: TreeLink. depth: INTEGER] - 
BEGIN 
firstSon: BOOLEAN <- TRUE; 

Printltem: TreeScan - 
BEGIN OPEN lODefs; 

IF -firstSon THEN WriteString['\ "L] ELSE firstSon ♦- FALSE; 
IF t # empty THEN PrintOperand[t, 0, depth]; 
RETURN 
END; 

scan1ist[t. Printltem]; RETURN 
END; 

— error-handling routines 

ErrorLog: PROCEDURE • 
BEGIN OPEN lODefs; 
bodyld: ISEIndex; 
WriteString[". at "L]; 
IF dataPtr.bodylndex # BTNull 
THEN 

BEGIN OPEN TableDefs; 

bodyld *- (TableBounds[bodytype].base+dataPtr.bodyIndex).id; 

IF bodyld » SENull THEN WriteSei[bodyId]; 

END; 
WriteChar[*[]; 

WriteNumber[dataPtr.textIndex. [base:8, zerof ill :FALSE, unsigned:TRUE, columns:0]]; 
WriteChar[']]; WriteChar[' :]; WriteChar[CR]; 
Pr i n tText Li ne[da tap tr. text Index] ; 
RETURN 
END; 

error: PUBLIC PROCEDURE [code: ErrorCode] - 
BEGIN OPEN lODefs; 
LockStringTable[]; 

WriteCharfCR]; WriteErrorString[code]; 
dataPtr.nErrors ^ dataPtr .nErrors + 1; 
ErrorLog[]; 

CompilerDefs.CloseStringTable[]; RETURN 
END; 

errorhti: PUBLIC PROCEDURE [code: ErrorCode. hti: HTIndex] - 
BEGIN 

err or tree [code, TreeLink[hash[hti]]]; 
RETURN 
END; 

errorsei: PUBLIC PROCEDURE [code: ErrorCode, sei: ISEIndex] - 
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BEGIN 

error tree [code, TreeLink[symbo1[se1]]]; 

RETURN 

END; 

errorstring: PUBLIC PROCEDURE [code: ErrorCode. s: STRING] - 
BEGIN OPEN lODefs; 
LockStringTab1e[]; 

Wr1teChar[CR]; WriteStr1ng[s] ; WriteChar[' ]; 
WriteErrorString[code]; 
dataPtr.nErrors <- dataPtr.nErrors + 1; 
ErrorLog[3; 

CompnerDefs.C1oseStringTab1e[]; RETURN 
END; 

errorn: PUBLIC PROCEDURE [code: ErrorCode, n: INTEGER] - 
BEGIN OPEN lODefs; 
LockStringTab1e[]; 

WriteChar[CR]; Wr1teDecima1[n]; Wr1teChar[' ]; 
WriteErrorString[code]; 
dataPtr.nErrors ♦- dataPtr.nErrors + 1; 
ErrorLog[]; 

CoinpilerDefs.CloseStringTable[]; RETURN 
END; 

errortree: PUBLIC PROCEDURE [code: ErrorCode. t: TreeLink] ■ 
BEGIN OPEN lODefs; 
LockStringTab1e[]; 

WriteChar[CR]; PrintOperand[t, 0, 0]; 
WriteChar[' ]; WriteChar[' ]; WriteErrorString[code]; 
dataPtr.nErrors ^ dataPtr.nErrors + 1; 
ErrorLog[]; 

CompilerDefs.CloseStringTable[]; RETURN 
END; 

Warning: PUBLIC PROCEDURE [code: ErrorCode] ■ 
BEGIN 

IF dataPtr. warnings 
THEN 

BEGIN OPEN lODefs; 

LockStringTab1e[]; 

WriteChar[CR]; WriteErrorString[code]; 

dataPtr.nWarnings ^ dataPtr . nWarnings + 1; 

ErrorLog[]; 

CompilerDefs.C1oseStringTable[]; 

END; 
RETURN 
END; 

WarningSei: PUBLIC PROCEDURE [code: ErrorCode, sei: ISEIndex] - 
BEGIN 

IF dataPtr. warnings THEN WarningTree[code. TreeLink[synibo1[sei]]]; 
RETURN 
END; 

WarningTree: PUBLIC PROCEDURE [code: ErrorCode, t: TreeLink] ■ 
BEGIN 

IF dataPtr. warnings 
THEN 

BEGIN OPEN lODefs; 

LockStringTable[]; 

WriteChar[CR]; PrintOperand[t, 0. 0]; 

WriteCharf' ]; WriteChar[' ]; WriteErrorString[code]; 

dataPtr.nWarnings ^ dataPtr.nWarnings + 1; 

ErrorLog[]; 

Compi1erDefs.C1os0StringTable[]; 

END; 
RETURN 
END; 

END. 



